{-# LANGUAGE TupleSections #-}
-- | Log file retrieval using log-warper, for the purpose of reporting.

module Pos.Infra.Reporting.Wlog
    ( withWlogTempFile
    , readWlogFile
    , compressLogs
    , withTempLogFile
    , LoggerConfig (..)
    ) where

import           Universum

import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import           Data.Conduit (runConduitRes, yield, (.|))
import           Data.Conduit.List (consume)
import qualified Data.Conduit.Lzma as Lzma
import           Data.List (isInfixOf)
import qualified Data.Text.IO as TIO
import           Data.Time.Clock (getCurrentTime)
import           Data.Time.Format (defaultTimeLocale, formatTime)
import           System.Directory (canonicalizePath, doesFileExist,
                     getTemporaryDirectory, removeFile)
import           System.FilePath (takeFileName, (</>))
import           System.IO (IOMode (WriteMode), hClose, hFlush, withFile)

import           Pos.Util.Wlog (LoggerConfig (..), retrieveLogContent)

import           Pos.Util.Log.LoggerConfig (lcBasePath, retrieveLogFiles)


-- FIXME we get PackingError from here, but it should defined locally, since
-- it's log-warper specific.
import           Pos.Infra.Reporting.Exceptions (ReportingError (..))
import           Pos.Util.Filesystem (withSystemTempFile)
import           Pos.Util.Util ((<//>))


-- | Use a 'LoggerConfig' to get logs, write them to a temporary file,
-- tar and compress that file, canonicalize its path, run the continuation
-- with that path (or 'Nothing' if there are no logs), then clean up the
-- temporary files after the continuation has finished.
withWlogTempFile :: LoggerConfig -> (Maybe FilePath -> IO t) -> IO t
withWlogTempFile logConfig k = do
    mRawLogs <- readWlogFile logConfig
    case mRawLogs of
        Nothing      -> k Nothing
        Just rawLogs -> withTempLogFile rawLogs $ \fp -> k (Just fp)

-- | Use a 'LoggerConfig' to get logs.
readWlogFile :: LoggerConfig -> IO (Maybe Text)
readWlogFile logConfig = case mLogFile of
    Nothing -> pure Nothing
    Just logFile -> do
        -- TBD will 'retrieveLogContent' fail if the file doesn't
        -- exist?
        logContent <-
            takeGlobalSize charsConst <$>
            retrieveLogContent logFile (Just 5000)
        pure (Just (unlines (reverse logContent)))
  where
    -- Grab all public log files, using the 'LoggerConfig', and take the
    -- first one.
    basepath = fromMaybe "./" $ logConfig ^. lcBasePath
    allFiles = map ((</> basepath) . snd) $ retrieveLogFiles logConfig
    mLogFile = case filter (".json" `isInfixOf`) allFiles of
                    []    -> Nothing
                    (f:_) -> Just f
    -- 2 megabytes, assuming we use chars which are ASCII mostly
    charsConst :: Int
    charsConst = 1024 * 1024 * 2
    takeGlobalSize :: Int -> [Text] -> [Text]
    takeGlobalSize _ [] = []
    takeGlobalSize curLimit (t:xs) =
        let delta = curLimit - length t
        in bool [] (t : (takeGlobalSize delta xs)) (delta > 0)

-- | Pass a list of absolute paths to log files. This function will
-- archive and compress these files and put resulting file into log
-- directory (returning filepath is absolute).
--
-- It will throw a PackingError in case:
--   - Any of the file paths given does not point to an existing file.
--   - Any of the file paths could not be converted to a tar path, for instance
--     because it is too long.
compressLogs :: [FilePath] -> IO FilePath
compressLogs files = do
    tar <- tarPackIndependently files
    tarxz <-
        BS.concat <$>
        runConduitRes (yield tar .| Lzma.compress (Just 0) .| consume)
    aName <- getArchiveName
    withFile aName WriteMode $ \handle -> do
        BS.hPut handle tarxz
        hFlush handle
    pure aName
  where
    tarPackIndependently :: [FilePath] -> IO ByteString
    tarPackIndependently paths = do
        entries <- forM paths $ \p -> do
            unlessM (doesFileExist p) $ throwM $
                PackingError $ "can't pack log file " <> fromString p <>
                               " because it doesn't exist or it's not a file"
            tPath <- either (throwM . PackingError . fromString)
                            pure
                            (Tar.toTarPath False $ takeFileName p)
            pabs <- canonicalizePath p
            Tar.packFileEntry pabs tPath
        pure $ BSL.toStrict $ Tar.write entries
    getArchiveName = do
        curTime <- formatTime defaultTimeLocale "%q" <$> getCurrentTime
        tempDir <- getTemporaryDirectory
        pure $ tempDir <//> ("report-" <> curTime <> ".tar.lzma")

-- | Creates a temp file from given text
withTempLogFile :: Text -> (FilePath -> IO a) -> IO a
withTempLogFile rawLogs action = do
    withSystemTempFile "main.log" $ \tempFp tempHandle -> do
        let getArchivePath = do
                TIO.hPutStrLn tempHandle rawLogs
                hClose tempHandle
                archivePath <- compressLogs [tempFp]
                canonicalizePath archivePath
            removeArchive = removeFile
        bracket getArchivePath removeArchive action
